home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / eventq.exe / EVENTQ.PAS < prev    next >
Pascal/Delphi Source File  |  1991-07-13  |  10KB  |  280 lines
  1. {****************************************************************************}
  2. { The $X compiler directive must be set so that we can use the MessageBox    }
  3. { function without worrying about the result. Feel free to change any other  }
  4. { compiler settings if you want.                                             }
  5. {****************************************************************************}
  6.  
  7. {$X+}
  8. unit EventQ;
  9.  
  10. interface
  11.  
  12. uses Drivers,Objects,Views,MsgBox,App;
  13.  
  14. {****************************************************************************}
  15. { This is the type declaration for the event queue object itself. Unless you }
  16. { plan to significantly modify the functionality of this unit, you can       }
  17. { pretty much ignore the internal implementation of TEventQueue. Do look at  }
  18. { the Init and PutQ methods, however, so you can see how the possible error  }
  19. { conditions are handled; you may need to modify the implementation of these }
  20. { methods for your own application.                                          }
  21. {****************************************************************************}
  22.  
  23. type
  24.   PEventQueue = ^TEventQueue;
  25.   TEventQueue = object (TObject)
  26.     QueuePtr: Pointer;
  27.     Head,Tail,Size: Word;
  28.     constructor Init (ASize: Word);      { ASize is the length of the queue  }
  29.     function Empty: Boolean;             { return true if queue is empty     }
  30.     function Full: Boolean;              { return true if queue is full      }
  31.     procedure PutQ (var Event: TEvent);  { insert a new Event into the queue }
  32.     procedure GetQ (var Event: TEvent);  { remove next Event from the queue  }
  33.     destructor Done; virtual;
  34.     constructor Load (var S: TStream);
  35.     procedure Store (var S: TStream);
  36.     end;
  37.  
  38. {****************************************************************************}
  39. { TEventQueueApp is a simple descendant of TApplication which implements a   }
  40. { TEventQueue-type event queue. You can substitute 'TEventQueueApp' for      }
  41. { 'TApplication' in your program, and there will be no outward change in the }
  42. { program's functionality. However, you will have an additional method,      }
  43. { PushKey (Event), at your disposal. Invoking this method will insert Event  }
  44. { into the event queue. You can call this method from anywhere in your       }
  45. { application, as desired. Event must contain the same information as an     }
  46. { evKeyDown event. Strictly speaking, this unit only supports evKeyDown      }
  47. { events; however, you can also push other types of events if you know what  }
  48. { you are doing. Be aware that this might not always work as expected in all }
  49. { situations.                                                                }
  50. {****************************************************************************}
  51.  
  52.   PEventQApp = ^TEventQApp;
  53.   TEventQApp = object (TApplication)
  54.     EventQueue: TEventQueue;
  55.     constructor Init;
  56.     procedure PushKey (var Event: TEvent); virtual;
  57.     procedure PutEvent (var Event: TEvent); virtual;
  58.     procedure GetEvent (var Event: TEvent); virtual;
  59.     destructor Done; virtual;
  60.     constructor Load (var S: TStream);
  61.     procedure Store (var S: TStream);
  62.     end;
  63.  
  64. {****************************************************************************}
  65. { The following procedure is provided so that you may load and store your    }
  66. { TEventQApp's to and from a stream. Call this procedure (probably in your   }
  67. { application's Init method) before you attempt a Load or Store.             }
  68. {****************************************************************************}
  69.  
  70. procedure RegisterEventQ;
  71.  
  72. implementation
  73.  
  74. const
  75.   Pending: TEvent = (What: evNothing);  { same as in APP.PAS }
  76.  
  77. {****************************************************************************}
  78. { The following constants may need to be changed, depending on your          }
  79. { application. QueueSize must be set larger than the maximum number of       }
  80. { keystrokes you expect to push onto the queue at one time. NEventQueue and  }
  81. { NEventApp are the (arbitrary) object registration numbers for the object   }
  82. { types defined in this unit. In the unlikely event that the numbers         }
  83. { conflict with any others that you are using, you will have to change one   }
  84. { or the other.                                                              }
  85. {****************************************************************************}
  86.  
  87.   QueueSize = 100;
  88.   NEventQueue = 31416;
  89.   NEventQApp = 27183;
  90.  
  91. {****************************************************************************}
  92. { TEventQueue.Init attempts to allocate space for the event queue. If there  }
  93. { is not enough memory available, it pops up a message box to inform the     }
  94. { user of the fact. You might want to handle the situation differently in    }
  95. { your application.                                                          }
  96. {****************************************************************************}
  97.  
  98. constructor TEventQueue.Init (ASize: Word);
  99.  
  100. begin
  101. TObject.Init;
  102. if MaxAvail < ASize * SizeOf (TEvent) then
  103.   begin
  104.   MessageBox ('Not enough memory to build event queue.',nil,
  105.   mfError + mfOkButton);
  106.   Fail;
  107.   end
  108. else begin
  109.   GetMem (QueuePtr,ASize * SizeOf (TEvent));
  110.   Size := ASize;
  111.   Head := 0;
  112.   Tail := 0;
  113.   end;
  114. end;  {TEventQueue.Init}
  115.  
  116. function TEventQueue.Empty: Boolean;
  117.  
  118. begin
  119. Empty := Head = Tail;
  120. end;  {TEventQueue.Empty}
  121.  
  122. function TEventQueue.Full: Boolean;
  123.  
  124. begin
  125. Full := (Head = Tail + 1) or ((Head = 0) and (Tail = Size - 1));
  126. end;  {TEventQueue.Full}
  127.  
  128. {****************************************************************************}
  129. { If the event queue is full, PutQ simply ignores any attempt to add another }
  130. { event to the queue. This may or may not be acceptable in your application. }
  131. {****************************************************************************}
  132.  
  133. procedure TEventQueue.PutQ (var Event: TEvent);
  134.  
  135. begin
  136. PEvent (Ptr (Seg (QueuePtr^),
  137.   Ofs (QueuePtr^) + Tail * SizeOf (TEvent)))^ := Event;
  138. Tail := (Tail + 1) mod Size;
  139. end;  {TEventQueue.PutQ}
  140.  
  141. procedure TEventQueue.GetQ (var Event: TEvent);
  142.  
  143. begin
  144. Event := PEvent (Ptr (Seg (QueuePtr^),
  145.   Ofs (QueuePtr^) + Head * SizeOf (TEvent)))^;
  146. Head := (Head + 1) mod Size;
  147. end;  {TEventQueue.GetQ}
  148.  
  149. destructor TEventQueue.Done;
  150.  
  151. begin
  152. FreeMem (QueuePtr,Size * SizeOf (TEvent));
  153. Size := 0;
  154. Head := 0;
  155. Tail := 0;
  156. TObject.Done;
  157. end;  {TEventQueue.Done}
  158.  
  159. constructor TEventQueue.Load (var S: TStream);
  160.  
  161. begin
  162. S.Read (QueuePtr,SizeOf (Pointer));
  163. S.Read (Head,SizeOf (Word));
  164. S.Read (Tail,SizeOf (Word));
  165. S.Read (Size,SizeOf (Word));
  166. end;  {TEventQueue.Load}
  167.  
  168. procedure TEventQueue.Store (var S: TStream);
  169.  
  170. begin
  171. S.Write (QueuePtr,SizeOf (Pointer));
  172. S.Write (Head,SizeOf (Word));
  173. S.Write (Tail,SizeOf (Word));
  174. S.Write (Size,SizeOf (Word));
  175. end;  {TEventQueue.Store}
  176.  
  177. constructor TEventQApp.Init;
  178.  
  179. begin
  180. TApplication.Init;
  181. if not EventQueue.Init (QueueSize) then Fail;
  182. end;  {TEventQApp.Init}
  183.  
  184. procedure TEventQApp.PushKey (var Event: TEvent);
  185.  
  186. begin
  187. if not EventQueue.Full then EventQueue.PutQ (Event);
  188. end;  {TEventQApp.PushKey}
  189.  
  190. {****************************************************************************}
  191. { The PutEvent and GetEvent methods are basically copied wholesale from      }
  192. { APP.PAS; GetEvent is modified to grab a keystroke event from the event     }
  193. { queue if one is available. Otherwise, both methods function identically to }
  194. { the ones in the App unit. It was necessary to copy PutEvent, even though   }
  195. { it is not changed, because both it and GetEvent access the Pending         }
  196. { variable, which is hidden in App's implementation section.                 }
  197. {****************************************************************************}
  198.  
  199. procedure TEventQApp.PutEvent (var Event: TEvent);
  200.  
  201. begin
  202. Pending := Event;
  203. end;  {TEventQApp.PutEvent}
  204.  
  205. procedure TEventQApp.GetEvent (var Event: TEvent);
  206.  
  207.   function ContainsMouse (P:PView): Boolean; far;
  208.  
  209.   begin
  210.   ContainsMouse := (P^.State and sfVisible <> 0) and
  211.     P^.MouseInView (Event.Where);
  212.   end;
  213.  
  214. begin
  215. if Pendin